unit IdxRest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Comctrls, Db, FMTBcd, SqlExpr;

type
  TIdx = class(TDataModule)
    OldIdx: TSQLDataSet;
    NewIdx: TSQLDataSet;
    OldIdxDef: TSQLDataSet;
    NewIdxDef: TSQLDataSet;
    OldPrim: TSQLDataSet;
    OldCon: TSQLDataSet;
    OldConRef: TSQLDataSet;
    NewPrim: TSQLDataSet;
    NewCon: TSQLDataSet;
    NewConRef: TSQLDataSet;
  private
    { Private declarations }
    function TIdx(DBType: Byte): TDataSet;
    function TPrim(DBType: Byte): TDataSet;
    function IdxDef(DBType : Byte) : TDataSet;
    function IndexName(DBType : Byte) : String;
    function IndexNamePrim(DBType : Byte) : String;
    function PrimName(DBType : Byte) : String;
    function TableName(DBType : Byte) : String;
    function TableNamePrim(DBType : Byte) : String;
    function GetIndexFields(DBType : Byte) : String;
    function IsUniqueIdx(DBType : Byte) : String;
    { Private declarations }

    procedure CreatePrimaryKey(Fields : String);
    procedure AlterPrimaryKey(Fields : String);
    procedure CreateSecondaryIndex(Fields : String);
    procedure AlterSecondaryIndex(Fields : String);
  public
    { Public declarations }
    procedure CheckPrimaryKey;
    procedure CheckIndex;
    procedure CheckForeignKey;
  end;

var
  Idx: TIdx;

procedure CheckPrimaryKeys(ProgBar : TProgressBar);
procedure CheckSecondaryIndices(ProgBar : TProgressBar);
procedure CheckForeignKeys(ProgBar : TProgressBar);

implementation

{$R *.DFM}

uses Data, ReportForm;

procedure CheckPrimaryKeys(ProgBar : TProgressBar);
begin
  ProgBar.Position:=0;
  // how many primary keys are there ?
  Idx.NewPrim.CommandText:=
    'select count(*) as ccc from RDB$RELATION_CONSTRAINTS '+
    'where RDB$CONSTRAINT_TYPE='#39'PRIMARY KEY'#39;
  Idx.NewPrim.Open;
  ProgBar.Max:=Idx.NewPrim.fieldByName('ccc').AsInteger;
  Idx.NewPrim.Close;

  Idx.NewPrim.CommandText:=
    'select * from RDB$RELATION_CONSTRAINTS '+
    'where RDB$CONSTRAINT_TYPE='#39'PRIMARY KEY'#39;

  Idx.NewPrim.Open;
  Idx.OldPrim.Open;
  Idx.NewPrim.First;
  While not Idx.NewPrim.Eof do
  begin
    Application.ProcessMessages;
    ProgBar.Position:=ProgBar.Position+1;
    Idx.CheckPrimaryKey;
    Idx.NewPrim.Next;
  end;
  Idx.OldPrim.Close;
  Idx.NewPrim.Close;

end;

procedure CheckSecondaryIndices(ProgBar : TProgressBar);
begin
  ProgBar.Position:=0;
  // how many indices are there ?
  Idx.NewIdx.CommandText:=
    'select count(*) as ccc from RDB$INDICES '+
    'where RDB$SYSTEM_FLAG IS NULL';
  Idx.NewIdx.Open;
  ProgBar.Max:=Idx.NewIdx.fieldByName('ccc').AsInteger;
  Idx.NewIdx.Close;

  Idx.NewIdx.CommandText:=
    'select * from RDB$INDICES '+
    'where RDB$SYSTEM_FLAG IS NULL';

  Idx.NewIdx.Open;
  Idx.OldIdx.Open;
  Idx.NewIdx.First;
  While not Idx.NewIdx.Eof do
  begin
    ProgBar.Position:=ProgBar.Position+1;
    Idx.CheckIndex;
    Idx.NewIdx.Next;
  end;
  Idx.OldIdx.Close;
  Idx.NewIdx.Close;
end;

procedure CheckForeignKeys(ProgBar : TProgressBar);
begin
  ProgBar.Position:=0;
  // how many foreign keys are there ?
  Idx.NewCon.CommandText:=
    'select count(*) as ccc from RDB$RELATION_CONSTRAINTS '+
    'where RDB$CONSTRAINT_TYPE='#39'FOREIGN KEY'#39;
  Idx.NewCon.Open;
  ProgBar.Max:=Idx.NewCon.fieldByName('ccc').AsInteger;
  Idx.NewCon.Close;

  Idx.NewCon.CommandText:=
    'select * from RDB$RELATION_CONSTRAINTS '+
    'where RDB$CONSTRAINT_TYPE='#39'FOREIGN KEY'#39;


  Idx.NewCon.Open;
  Idx.NewIdx.Open;
  Idx.OldCon.Open;
  Idx.OldIdx.Open;

  Idx.NewCon.First;
  While not Idx.NewCon.Eof do
  begin
    ProgBar.Position:=ProgBar.Position+1;
    Idx.CheckForeignKey;
    Idx.NewCon.Next;
  end;
  Idx.OldIdx.Close;
  Idx.OldCon.Close;
  Idx.NewIdx.Close;
  Idx.NewCon.Close;
end;

{ TIdx }

function TIdx.TIdx(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewIdx;
    fcOld : Result:=OldIdx;
  end;
end;

function TIdx.TPrim(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewPrim;
    fcOld : Result:=OldPrim;
  end;
end;

function TIdx.IdxDef(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewIdxDef;
    fcOld : Result:=OldIdxDef;
  end;
end;

function TIdx.GetIndexFields(DBType: Byte): String;
var DS : TDataSet;
begin
  Result:='';
  DS:=IdxDef(DBType);
  DS.Open;
  DS.First;
  While not DS.Eof do
  begin
    Result:=Result+Trim(DS.FieldByName('RDB$FIELD_NAME').AsString);
    DS.Next;
    if not DS.Eof then Result:=Result+', ';
  end;
  DS.Close;
end;

function TIdx.IsUniqueIdx(DBType: Byte): String;
begin
  Result:=Trim(TIdx(DBType).FieldByName('RDB$UNIQUE_FLAG').AsString);
end;

function TIdx.IndexName(DBType : Byte) : String;
begin
  Result:=Trim(TIdx(DBType).FieldByName('RDB$INDEX_NAME').AsString);
end;

function TIdx.IndexNamePrim(DBType: Byte): String;
begin
  Result:=Trim(TPrim(DBType).FieldByName('RDB$INDEX_NAME').AsString);
end;

function TIdx.TableName(DBType : Byte): String;
begin
  Result:=Trim(TIdx(DBType).FieldByName('RDB$RELATION_NAME').AsString);
end;

function TIdx.TableNamePrim(DBType : Byte): String;
begin
  Result:=Trim(TPrim(DBType).FieldByName('RDB$RELATION_NAME').AsString);
end;

function TIdx.PrimName(DBType: Byte): String;
begin
  Result:=Trim(TPrim(DBType).FieldByName('RDB$CONSTRAINT_NAME').AsString);
end;

procedure TIdx.AlterPrimaryKey(Fields: String);
begin
  DM.SQL.Clear;
  DM.SQL.Add('ALTER TABLE '+TableNamePrim(fcNew));
  DM.SQL.Add('DROP CONSTRAINT '+PrimName(fcOld));

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
    except
      if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'drop error');
    end;
  end else
    DM.AddToStrings('TABLE '+TableNamePrim(fcNew),DM.SQL);

  DM.SQL.Clear;
  DM.SQL.Add('ALTER TABLE '+TableNamePrim(fcNew));
  DM.SQL.Add('ADD CONSTRAINT '+PrimName(fcNew));
  DM.SQL.Add('PRIMARY KEY ('+Fields+')');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'different');
    except
      if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('TABLE '+TableNamePrim(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'different');
  end;
end;

procedure TIdx.CreatePrimaryKey(Fields: String);
begin
  DM.SQL.Clear;
  DM.SQL.Add('ALTER TABLE '+TableNamePrim(fcNew));
  DM.SQL.Add('ADD CONSTRAINT '+PrimName(fcNew));
  DM.SQL.Add('PRIMARY KEY ('+Fields+')');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'not exist');
    except
      if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('TABLE '+TableNamePrim(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('PRIMARY KEY',Trim(TableNamePrim(fcNew)),'not exist');
  end;
end;

procedure TIdx.CheckPrimaryKey;
var OldS,
    NewS : String;
begin
  // let's see fields for primary key
  NewIdxDef.ParamByName('IDXNAME').AsString:=IndexNamePrim(fcNew);
  NewS:=GetIndexFields(fcNew);

  // I need to locate OldPrim if there exist constraint for primary key
  OldPrim.Close;
  OldPrim.ParamByName('PName').AsString:=TableNamePrim(fcNew);
  OldPrim.Open;
  if Trim(OldPrim.FieldByName('RDB$RELATION_NAME').AsString)=TableNamePrim(fcNew) then
  begin
    // yes, there is. But is the same name ?
    if PrimName(fcNew)=PrimName(fcOld) then
    begin
      // What about fields in old table ?
      OldIdxDef.ParamByName('IDXNAME').AsString:=IndexNamePrim(fcOld);
      OldS:=GetIndexFields(fcOld);
      if OldS<>NewS then AlterPrimaryKey(NewS);
    end else
      AlterPrimaryKey(NewS);
  end else
    CreatePrimaryKey(NewS);
end;

procedure TIdx.CheckForeignKey;
var ConName,
    NewTabName,
    NewConFields,
    NewFKTabName,
    NewFKFields,
    NewOnDel,
    NewOnUpd,
    OldTabName,
    OldConFields,
    OldFKTabName,
    OldFKFields,
    OldOnDel,
    OldOnUpd,

    RefIdxName,
    ConKey,
    RefKey : String;

    procedure CreateForeignKey;
    begin
      DM.SQL.Clear;
      DM.SQL.Add('ALTER TABLE '+NewTabName);
      DM.SQL.Add('ADD CONSTRAINT '+ConName);
      DM.SQL.Add('FOREIGN KEY ('+NewConFields+')');
      DM.SQL.Add('REFERENCES '+NewFKTabName+' ('+NewFKFields+')');
      if NewOnDel<> 'RESTRICT' then
        DM.SQL.Add('ON DELETE '+NewOnDel);
      if NewOnUpd<> 'RESTRICT' then
        DM.SQL.Add('ON UPDATE '+NewOnUpd);

      if DM.AutoRepair then DM.ExecRunSQL else
        DM.AddToStrings('TABLE '+NewTabName,DM.SQL);

    end;

    procedure AlterForeignKey;
    begin
      DM.SQL.Clear;
      DM.SQL.Add('ALTER TABLE '+NewTabName);
      DM.SQL.Add('DROP CONSTRAINT '+ConName);

      if DM.AutoRepair then DM.ExecRunSQL else
        DM.AddToStrings('TABLE '+NewTabName,DM.SQL);

      CreateForeignKey;
    end;

begin
  // I need all parameters of new foreign key
  // In RDB$RELATION_CONSTRAINTS is Constraint Name, Relation Name and Foreign Key Name
  ConName:=Trim(NewCon.FieldByName('RDB$CONSTRAINT_NAME').AsString);
  NewTabName:=Trim(NewCon.FieldByName('RDB$RELATION_NAME').AsString);
  //RefIdxName:=Trim(NewCon.FieldByName('RDB$INDEX_NAME').AsString);
  RefIdxName:=NewCon.FieldByName('RDB$INDEX_NAME').AsString;

  // in RDB$INDEX_SEGMENTS are fields
  NewIdxDef.ParamByName('IDXNAME').AsString:=RefIdxName;
  NewConFields:=GetIndexFields(fcNew);

  // in RDB$INDICES is key for Foreign Table
  NewIdx.Locate('RDB$INDEX_NAME',RefIdxName,[]);
  RefIdxName:=NewIdx.FieldByName('RDB$FOREIGN_KEY').AsString;

  // in RDB$INDICES is Foreign key Table
  NewIdx.Locate('RDB$INDEX_NAME',RefIdxName,[]);
  NewFKTabName:=Trim(NewIdx.FieldByName('RDB$RELATION_NAME').AsString);

  // in RDB$INDEX_SEGMENTS are fields for Foreign Table Key
  NewIdxDef.ParamByName('IDXNAME').AsString:=RefIdxName;
  NewFKFIelds:=GetIndexFields(fcNew);

  // in RDB$REF_CONSTRAINTS are fields for rules
  NewConRef.ParamByName('CONNAME').AsString:=ConName;
  NewConRef.Open;
  NewOnDel:=Trim(NewConRef.FieldByName('RDB$DELETE_RULE').AsString);
  NewOnUpd:=Trim(NewConRef.FieldByName('RDB$UPDATE_RULE').AsString);
  NewConRef.Close;

  // ok, let's rock
  OldCon.Close;
  OldCon.ParamByName('CName').AsString:=ConName;
  OldCon.Open;
  if Trim(OldCon.FieldByName('RDB$CONSTRAINT_NAME').AsString)=ConName then
  begin
    // foreign key exist, check for properties
    OldTabName:=Trim(OldCon.FieldByName('RDB$RELATION_NAME').AsString);
    RefIdxName:=Trim(OldCon.FieldByName('RDB$INDEX_NAME').AsString);

    // in RDB$INDEX_SEGMENTS are fields
    OldIdxDef.ParamByName('IDXNAME').AsString:=RefIdxName;
    OldConFields:=GetIndexFields(fcOld);

    // in RDB$INDICES is key for Foreign Table
    OldIdx.Close;
    OldIdx.ParamByName('IName').AsString:=RefIdxName;
    OldIdx.Open;
    RefIdxName:=Trim(OldIdx.FieldByName('RDB$FOREIGN_KEY').AsString);

    // in RDB$INDICES is Foreign key Table
    OldIdx.Close;
    OldIdx.ParamByName('IName').AsString:=RefIdxName;
    OldIdx.Open;
    OldFKTabName:=Trim(OldIdx.FieldByName('RDB$RELATION_NAME').AsString);

    // in RDB$INDEX_SEGMENTS are fields for Foreign Table Key
    OldIdxDef.ParamByName('IDXNAME').AsString:=RefIdxName;
    OldFKFIelds:=GetIndexFields(fcOld);

    // in RDB$REF_CONSTRAINTS are fields for rules
    OldConRef.ParamByName('CONNAME').AsString:=ConName;
    OldConRef.Open;
    OldOnDel:=Trim(OldConRef.FieldByName('RDB$DELETE_RULE').AsString);
    OldOnUpd:=Trim(OldConRef.FieldByName('RDB$UPDATE_RULE').AsString);
    OldConRef.Close;

    if (NewTabName<>OldTabName) or (OldConFields<>NewConFields) or
      (OldFKTabName<>NewFKTabName) or (OldFKFields<>NewFKFields) or
        (NewOnDel<>OldOnDel) or (NewOnUpd<>OldOnUpd) then
    begin
      AlterForeignKey;
      if DM.ShowReport then Rep.AddToReport('CONSTRAINT',ConName,'different');
    end;
  end else
  begin
    CreateForeignKey;
    if DM.ShowReport then Rep.AddToReport('CONSTRAINT',ConName,'not exist');
  end;
end;

procedure TIdx.AlterSecondaryIndex(Fields: String);
begin
  try
    DM.SQL.Clear;
    DM.SQL.Add('DROP INDEX '+IndexName(fcNew));

    if DM.AutoRepair then DM.ExecRunSQL else
      DM.AddToStrings('TABLE '+TableName(fcNew),DM.SQL);

    DM.SQL.Clear;
    if IsUniqueIdx(fcNew)='1' then
      DM.SQL.Add('CREATE UNIQUE INDEX '+IndexName(fcNew))
    else
      DM.SQL.Add('CREATE INDEX '+IndexName(fcNew));
    DM.SQL.Add('ON '+TableName(fcNew)+' ('+Fields+')');

    if DM.AutoRepair then
    begin
      try
        DM.ExecRunSQL;
        if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'different');
      except
        if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'error');
      end;
    end else
    begin
      DM.AddToStrings('TABLE '+TableName(fcNew),DM.SQL);
      if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'different');
    end;
  except
  end;
end;

procedure TIdx.CreateSecondaryIndex(Fields: String);
begin
  DM.SQL.Clear;
  if IsUniqueIdx(fcOld)='1' then
    DM.SQL.Add('CREATE UNIQUE INDEX '+IndexName(fcNew))
  else
    DM.SQL.Add('CREATE INDEX '+IndexName(fcNew));
  DM.SQL.Add('ON '+TableName(fcNew)+' ('+Fields+')');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'not exist');
    except
      if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('TABLE '+TableName(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('INDEX',Trim(IndexName(fcNew)),'not exist');
  end;
end;

procedure TIdx.CheckIndex;
var OldS,
    NewS : String;
    OldU,
    NewU : String;
begin
  // is this secondary index
  if Copy(IndexName(fcNew),1,4)<>'RDB$' then
  begin
    // yes, let's see fields
    NewIdxDef.ParamByName('IDXNAME').AsString:=IndexName(fcNew);
    NewS:=GetIndexFields(fcNew);
    NewU:=isUniqueIdx(fcNew);
    if NewU='' then NewU:='0';

    // I have to locate OldIdx if there exist this index
    OldIdx.Close;
    OldIdx.ParamByName('IName').AsString:=IndexName(fcNew);
    OldIdx.Open;
    if IndexName(fcOld)=IndexName(fcNew) then
    begin
      // yes, there is an index
      OldIdxDef.ParamByName('IDXNAME').AsString:=IndexName(fcNew);
      OldS:=GetIndexFields(fcOld);
      OldU:=isUniqueIdx(fcOld);
      if OldU='' then OldU:='0';
      if (OldS<>NewS) or (OldU<>NewU) then
      begin
        AlterSecondaryIndex(NewS);
      end;
    end else CreateSecondaryIndex(NewS);
  end;

end;

end.
